home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / comm / thor / DLManager.lha / DLManager.thor < prev   
Text File  |  1996-12-24  |  9KB  |  399 lines
  1. /*
  2. **   Filename: DLManager.thor
  3. **
  4. **   $VER: 1.0 (21.12.96)
  5. **
  6. **   Author: Troy E. Bouchard
  7. **
  8. */
  9.  
  10. SIGNAL ON SYNTAX
  11. SIGNAL ON HALT
  12.  
  13. EVE_ENTERMSG = 0
  14.  
  15. /* Find our Thor Port and number! */
  16. p = Address() || ' ' || show('P',,)
  17.     ThorPort = pos('THOR.',p)
  18.  
  19.     if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
  20. else
  21.     do
  22.     say "Can't seem to find the Thor port!"
  23.     exit 10
  24.     End
  25.  
  26. /* Load the BBSRead library up! */
  27. if ~show('p', 'BBSREAD') then
  28. do
  29.    address command
  30.       "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  31.      "WaitForPort BBSREAD"
  32. End
  33.  
  34. if ~Show('L','rexxarplib.library') then
  35. do
  36.    if ~AddLib('rexxarplib.library',0,-30,0) then
  37.    do
  38.       Address(ThorPort)
  39.       'REQUESTNOTIFY TEXT '"Couldn't open rexxarplib.library"' BT "_Exiting!"'
  40.       exit 5
  41.    end
  42. end
  43.  
  44. if ~Show('L','rexxsupport.library') then
  45. do
  46.    if ~AddLib('rexxsupport.library',0,-30,0) then
  47.    do
  48.       Address(ThorPort)
  49.       'REQUESTNOTIFY TEXT '"Couldn't open rexxsupport.library"' BT "_Exiting!"'
  50.       exit 5
  51.    end
  52. end
  53.  
  54. 'GetGlobalConfig stem "'GC'"'
  55.  
  56. options results
  57.  
  58.    MyPort = OpenPort(DLPORT)
  59.    if MyPort = 0 then
  60.    do
  61.       Address(ThorPort)
  62.       'REQUESTNOTIFY TEXT '"Couldn't open the port"' BT "_Exiting!"'
  63.       exit 5
  64.    end
  65.  
  66.    address AREXX ,
  67.      "'Call CreateHost(DLHOST,DLPORT)'"
  68.  
  69.    do i = 1 to 10
  70.       if ~Showlist('P',DLHOST) then call delay 50
  71.       else leave i
  72.    end
  73.  
  74.    if i = 10 & ~Showlist('P',DLHOST) then
  75.    do
  76.       Address(ThorPort)
  77.       'REQUESTNOTIFY TEXT '"Couldn't open the Host"' BT "_Exiting!"'
  78.       exit 5
  79.    end
  80.  
  81.    call CreateWIN()
  82.  
  83.    Address(ThorPort)
  84.    'CURRENTSYSTEM stem "'BBSN'"'
  85.    if(rc ~= 0) then
  86.    do
  87.     Address(ThorPort)
  88.     'REQUESTNOTIFY TEXT "'Thor.LASTERROR'" BT "_Ok"'
  89.     Call Cleanup
  90.    end
  91.  
  92.    TB_SYSTEM = BBSN.BBSNAME
  93.    window.text = 'Current System: 'TB_SYSTEM
  94.    Call WindowText(DLHOST, window.text)
  95.  
  96. WaitStuff:
  97.    fini = 0
  98.  
  99.    do forever
  100.       if fini = 1 then leave
  101.       t = waitpkt(DLPORT)
  102.       do i = 1
  103.      p = getpkt(DLPORT)
  104.      if c2d(p) = 0 then leave i
  105.      cmd = getarg(p)
  106.      j = reply(p,0)
  107.      Select
  108.         When cmd = CLOSEWINDOW then do
  109.            Call Quit()
  110.         end
  111.         When cmd = GETSYSTEM then do
  112.            Call GetSystem()
  113.            win.txt = 'Current System: 'TB_SYSTEM
  114.            Call WindowText(DLHOST, win.txt)
  115.         end
  116.         When cmd = NEWLIST then do
  117.            Call NewList()
  118.         end
  119.         When cmd = WRITEMSG then do
  120.            Call WriteMSG()
  121.         end
  122.         When cmd = DELLIST then do
  123.            Call DeleteList
  124.         end
  125.         When cmd = QUIT then do
  126.            Call Quit()
  127.         end
  128.         otherwise nop
  129.      end
  130.       end
  131.    end
  132. Return
  133.  
  134. CreateWIN:
  135.    voffseta=0
  136.    voffsetb=0
  137.    gad. = ""
  138.    gad.0 = 28
  139.  
  140.    win.idcmp = "+CLOSEWINDOW+GADGETUP"
  141.    win.flags = "+WINDOWCLOSE+WINDOWDEPTH+BACKFILL+ACTIVATE"
  142.    win.title = "DLManager v1.0"
  143.  
  144.    gad.1.x = 30
  145.    gad.1.y = 38+voffseta
  146.    gad.1.name = "GETSYSTEM"
  147.    gad.1.text = " Get System "
  148.    gad.1.reportstring = "%d"
  149.  
  150.    gad.2.x = 30
  151.    gad.2.y = 56+voffseta
  152.    gad.2.name = "NEWLIST"
  153.    gad.2.text = "  New List  "
  154.    gad.2.reportstring = "%d"
  155.  
  156.    gad.3.x = 156
  157.    gad.3.y = 38+voffseta
  158.    gad.3.name = "WRITEMSG"
  159.    gad.3.text = " Write Mesg "
  160.    gad.3.reportstring = "%d"
  161.  
  162.    gad.4.x = 156
  163.    gad.4.y = 56+voffseta
  164.    gad.4.name = "DELLIST"
  165.    gad.4.text = " Delete List"
  166.    gad.4.reportstring = "%d"
  167.  
  168.    gad.5.x = 94
  169.    gad.5.y = 76+voffseta
  170.    gad.5.name = "QUIT"
  171.    gad.5.text = "    Quit    "
  172.    gad.5.reportstring = "%d"
  173.  
  174.    call SetReqColor(DLHOST,BACKGROUND,3) /* Color the Background */
  175.  
  176.    call OpenWindow(DLHOST, 160, 70, 285, 100, win.idcmp, win.flags, win.title)
  177.  
  178.    CNT = 0
  179.  
  180.    do n = 1 to gad.CNT
  181.       if gad.n.length = "" then
  182.      call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
  183.         gad.n.name, gad.n.text, gad.n.reportstring)
  184.       else
  185.      call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
  186.         gad.n.name, gad.n.text, gad.n.reportstring, ,
  187.            gad.n.length)
  188.    end
  189.  
  190. /* Color the Gadgets (set activate -> ON */
  191.    Call SetGadget(DLHOST, GETSYSTEM, ON)
  192.    Call SetGadget(DLHOST, NEWLIST,   ON)
  193.    Call SetGadget(DLHOST, WRITEMSG,  ON)
  194.    Call SetGadget(DLHOST, DELLIST,   ON)
  195.    Call SetGadget(DLHOST, QUIT,      ON)
  196. Return
  197.  
  198. GetSystem:
  199.    window.text = 'Current System: (None)'
  200.  
  201.    Address BBSREAD
  202.    'GETBBSLIST stem "'BBSLIST'"'
  203.    if(rc ~= 0) then
  204.    do
  205.     address(thorport)
  206.     'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
  207.     Call Cleanup
  208.    end
  209.  
  210.    Address(ThorPort)
  211.    'REQUESTLIST instem "'BBSLIST'" title "Select System:" SizeGadget'
  212.    if(rc ~= 0) then
  213.    do
  214.       Call WindowText(DLHOST, window.text)
  215.       Return
  216.    end
  217.  
  218.    TB_SYSTEM = result
  219. Return(TB_SYSTEM)
  220.  
  221. AddTDL:
  222.    Address(ThorPort)
  223.  
  224.    'RequestFile Title "Select the .tdl file" ID "'GC.SAVEDIR'" FP PAT "#?.tdl"'
  225.    if(rc = 5) then
  226.    do
  227.       'RequestNotify Text "Request Aborted!" BT "_Wow!"'
  228.       Call WaitStuff
  229.    end
  230.  
  231.    choice = result
  232.  
  233.    if ~Exists(choice) then
  234.    do
  235.       Call Open out, choice, 'w'
  236.       Call Close out
  237.    end
  238. Return
  239.  
  240. NewList:
  241.    Call AddTDL
  242.  
  243.    Address BBSREAD
  244.  
  245.    'SearchBRUser BBSNAME "'TB_SYSTEM'" Stem "'SResult'" Search "#?" Name Address'
  246.    if(rc ~= 0) then
  247.    do
  248.       Address(ThorPort)
  249.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  250.       Call Cleanup
  251.    end
  252.  
  253.    if(result > 0) then
  254.    do
  255.        Address BBSREAD
  256.  
  257.        drop LIST.
  258.        drop USERTAGS.
  259.  
  260.        LIST.COUNT = SResult.COUNT
  261.  
  262.        do j=1 to SResult.COUNT
  263.       LIST.j.USERNR = SResult.j.USERNR
  264.       'READBRUSER BBSNAME "'TB_SYSTEM'" UserNR "'SResult.j.USERNR'" TagsStem "'USERTAGS'"'
  265.       if(rc ~= 0) then
  266.       do
  267.          Address(ThorPort)
  268.          'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  269.          Return
  270.       End
  271.       LIST.j = USERTAGS.NAME || ' ' || USERTAGS.ADDRESS
  272.        end
  273.  
  274.        Address(ThorPort)
  275.        'REQUESTLIST instem "'LIST'" outstem "'USEL'" Title "Get User:" MultiSelect'
  276.        if(rc ~= 0) then
  277.        do
  278.       'REQUESTNOTIFY TEXT "Command Cancelled" BT "_OK"'
  279.       Return
  280.        end
  281.    end
  282.    Call Open out, Choice, 'a'
  283.  
  284.    do k = 1 to USEL.COUNT      /* Will appear as such:     */
  285.       Call WriteLN out, '%'       /* %                           */
  286.       Call WriteLN out, USEL.k      /* Troy tbouchar@ptialaska.net */
  287.    end                  /* %                 */
  288.    Call Close out          /* Mom mom@aol.com         */
  289. Return
  290.  
  291. WriteMSG:
  292.    Call AddTDL    /* get the distribution list */
  293.  
  294.    drop EVENT. /* make sure you free up the event */
  295.  
  296.    address(BBSREAD)
  297.    'UNIQUEMSGFILE bbsname "'TB_SYSTEM'" stem "'TDLFILE'"'
  298.    if(rc ~= 0) then
  299.    do
  300.       Address(ThorPort)
  301.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  302.       Return
  303.    end
  304.  
  305.    Address(ThorPort)
  306.    'REQUESTSTRING TITLE "Please enter your subject:" BT "_Ok|_Cancel" ID "DLManager v1.0" MAXCHARS 100'
  307.    EVENT.SUBJECT = result
  308.    if( rc ~= 0 | EVENT.SUBJECT = '') then
  309.       EVENT.SUBJECT = '(No Subject)' /* You always have to have a subject! */
  310.  
  311.    'StartEditor "'TDLFILE.NAME'"'  /* Start whatever configured editor you are using */
  312.  
  313.    EVENT.CONFERENCE = 'EMail'
  314.    EVENT.MSGFILE    = TDLFILE.FILEPART
  315.  
  316.    Call Open fh, choice, 'R'
  317.  
  318.    user = readln(fh)
  319.    do while(~eof(fh))
  320.       if(user = '%') then
  321.       do
  322.      user = readln(fh)
  323.  
  324.      nrwords = Words(user)
  325.      EVENT.TOADDR = Word(user, nrwords)
  326.  
  327.      if(nrwords = 3) then
  328.         nrwords = nrwords-2        /* are there two words? or one? */
  329.      else
  330.         nrwords = nrwords-1
  331.  
  332.      new = GetListName(Choice)
  333.  
  334.      EVENT.TONAME = new
  335.  
  336.      Address BBSREAD
  337.      'WRITEBREVENT bbsname "'TB_SYSTEM'" event "'EVE_ENTERMSG'" stem "'EVENT'"'
  338.      if(rc ~= 0) then
  339.      do
  340.         Address(ThorPort)
  341.         'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  342.         Call Close(fh) /* insanity check! */
  343.         Return
  344.      end
  345.      user = readln(fh)
  346.       end
  347.    end
  348.    Call Close(fh)
  349. Return
  350.  
  351. DeleteList:
  352.    Address(ThorPort)
  353.  
  354.    'RequestFile Title "Select the .tdl file to delete" ID "'GC.SAVEDIR'" FP PAT "#?.tdl"'
  355.    if(rc = 5) then
  356.    do
  357.       'RequestNotify Text "File Delete Aborted!" BT "_Whew!"'
  358.       Return
  359.    end
  360.  
  361.    Address Command 'Delete <>NIL: 'result
  362.    'RequestNotify Text "File Deleted!" BT "_YES!"'
  363. Return
  364.  
  365. Quit:
  366.    Address(ThorPort)
  367.    'RequestNotify Text "Do you really\nwant to quit?" BT "_Yes|Heck No!"'
  368.    if(rc ~= 0) then
  369.    do
  370.       'RequestNotify Text "'THOR.LASTERROR'" BT "_OK"'
  371.       Call Cleanup
  372.    end
  373.  
  374.    if ( result = 0 ) then Call WaitStuff
  375.    if ( result = 1 ) then Call Cleanup
  376. Return
  377.  
  378. SYNTAX:
  379.    SAY 'SYNTAX ERROR'
  380.    SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
  381. HALT:
  382. Cleanup:
  383.    Call CloseWindow(DLHOST)
  384.    fini = 1
  385.    Exit
  386.  
  387. GetListName: procedure
  388.          parse arg name
  389.  
  390.    psn = Lastpos('/', name)
  391.    psn = psn+1
  392.    listname = substr(name, psn)
  393.  
  394.    len = Length(listname)
  395.  
  396.    posn = len-4
  397.    lname = left(listname, posn)
  398. Return(lname)
  399.